perm filename CLFZ.OLD[MSS,LCS] blob
sn#107272 filedate 1974-06-15 generic text, type T, neo UTF8
C**** CLEFS, JDRAW, CENTR, LINX *********
SUBROUTINE CLEFS
IMPLICIT INTEGER(A-Q,S-Z)
DIMENSION JCLEF(10),MCLEF(600),RCMIN(4)
REAL DIS,PWDS,DISX,CENTR,POS,STF
COMMON /STF/RSTFAC(8),RSTJC
COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
COMMON/PLTR/PLT,RHT,DIS
DATA RCMIN/3.3,10.5,7.0,10.5/,JFX/-1/,NAME/0/
EQUIVALENCE (JD,JQ(2)),(RJD,RJQ(2)),(JE,JQ(3)),(JI,JQ(7))
1 ,(RJF,RJQ(4)),(RJE,RJQ(3)),(JH,JQ(6)),(RJG,RJQ(5))
1,(RJI,RJQ(7)),(NJR,RJQ(8))
DATA NAME/'BDR40'/
JE=MOD(JE,100)
JEZ=JE
IF(JA.EQ.3)GO TO 9
C YOU MUST TYPE "DRAW" NAME 1ST TIME. IT'S STICKY.
IF(NAME.EQ.NJR)GO TO 4
IF(NAME.NE.0.AND.NJR.EQ.0)GO TO 4
IF(NJR.EQ.0)GO TO 8
C TO PICK UP BASIC DRAW NAME FROM P10
NAME=NJR
GO TO 4
8 TYPE 5
ACCEPT 6,NAME
5 FORMAT(' "DRAW" NAME -- '$)
6 FORMAT(A5)
4 KA=JE/10
C KA LEADS TO PROPER FILE CALL
NM=NAME+2*KA
C DRAW0 HAS ITEMS 0→9; DRAW1, 10→19; ETC. TO DRAW9, 90→99
JEZ=MOD(JE,10)+1
GO TO 2
9 NM='CLFX'
2 IF(NM.EQ.JNM)GO TO 30
C SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
C JUMP IF ALREADY IN CORE
IF(LOOKD(NM))GO TO 1111
TYPE 1112,NM
RETURN
1112 FORMAT(1XA5,' -- NOT FOUND')
1111 JNM=NM
CALL RDDATA(NM,JCLEF,MCLEF)
30 CALL CENTER(CENTR)
C CHECK THE ABOVE -- FOR P5 HEIGHT CHANGE *********************
CALL NOZERO(RJF)
IF(RJG.EQ.0)RJG=RJF
C IF P7 = 0, IT WILL EQUAL P6.
C RJF IS SIZE FACTOR
IF(JE.GT.4.OR.JA.NE.3)GO TO 811
IF(JEZ.EQ.0)JEZ=1
IF(RJE.LT.100)GO TO 812
RSTJC=.8*RSTJC
CENTR=CENTR+RCMIN(JEZ)*RSTJC
C TO SET HGT. OF MINI CLEFS
812 IF(JEZ.NE.4)GO TO 811
CENTR=CENTR+RSTJC*14
JEZ=3
C ABOVE IS NOW AT TOP
811 L=JCLEF(JEZ)
IF(JI.NE.0)CALL ROTATE(MCLEF,L)
C RJI=P9=DEGREES OF ROTATION (0-360)
CALL JDRAW(MCLEF(L),RJB,CENTR,RSTJC,RJF,RJG)
C 3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, JH=-1 TO FILL ON CRT
C JH=-2 OMITS FILLER DURING PLOT
N=0
JD=MCLEF(L)+L
IF(MCLEF(JD).EQ.999)N=JD+1
1 IF(N.NE.0.AND.JH.NE.-2.AND.(PLT.OR.JH))CALL OLDFIL(MCLEF(N),
1 RJB,CENTR,RJF,RJG)
IF((JH.EQ.-2.AND.PLT).OR.(JH.NE.-1.AND.PLT.GE.0))GO TO 7
DO 3 K=L+1,MCLEF(L)+L
IF(MCLEF(K).LT.200000000)GO TO 3
JD=MCLEF(L)-1
IF(K.GT.L+1)JD=JD-K+L+1
CALL FILLMS(JD,MCLEF(K),RJB,CENTR,RJF,RJG)
GO TO 7
3 CONTINUE
CC7 IF(JI.NE.0)CALL UNROT(MCLEF(L))
C FILLS ONLY WHEN PLOTING OR RJG=-1
7 END
SUBROUTINE JDRAW(M,RJB,CENTR,RSTJC,RX,RY)
COMMON/LL/LL
DIMENSION M(1)
RC=RX*RSTJC
RD=RY*RSTJC
DO 2 K=2,M(1)
CALL UNPACK(IA,IB,M(K))
CC RA=IA*RC+RJB
CC RB=IB*RD+CENTR
CC IF(K.EQ.I)LL=3
CC2 CALL LINES(RA,RB,LL)
2 CALL LINES(FLOAT(IA)*RC+RJB,FLOAT(IB)*RD+CENTR,LL)
END
SUBROUTINE CENTER(CNTR)
C TO CENTER ITEMS CREATED WITH DRAWING PROG.
COMMON /STF/RSTFAC(8),RSTJC
COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
COMMON/POSI/STF(8),JJB,POS
EQUIVALENCE (RJD,RJQ(2))
CNTR=POS+(2+AMOD(RJD,100.)*7)*RSTJC
END
SUBROUTINE LINX(A,B,C,D)
C SAVES SPACE FOR SINGLE LINES.
CALL LINES(A,B,3)
CALL LINES(C,D,2)
END